unit keyboards;

{*
Multiplatform handling of keyboard input
}

interface

uses Classes, SysUtils, glut, debugs;

type
  TKey = (
    // Fn keys
    vkF1, vkF2, vkF3, vkF4, vkF5, vkF6, vkF7, vkF8, vkF9, vkF10, vkF11, vkF12,
    // arrows
    vkLeft, vkRight, vkUp, vkDown,
    // special keys
    vkEsc, vkPgUp, vkPgDn, vkHome, vkEnd, vkInsert, vkDelete, vkSpace, vkEnter, vkTab, vkBackSpace,
    // numbers
    vkNumber0, vkNumber1, vkNumber2, vkNumber3, vkNumber4, vkNumber5, vkNumber6, vkNumber7, vkNumber8, vkNumber9,
    // small letters
    vkSmallA, vkSmallB, vkSmallC, vkSmallD, vkSmallE, vkSmallF, vkSmallG, vkSmallH, vkSmallI, vkSmallJ, vkSmallK, vkSmallL, vkSmallM,
    vkSmallN, vkSmallO, vkSmallP, vkSmallQ, vkSmallR, vkSmallS, vkSmallT, vkSmallU, vkSmallV, vkSmallW, vkSmallX, vkSmallY, vkSmallZ,
    // capital leters
    vkCapitalA, vkCapitalB, vkCapitalC, vkCapitalD, vkCapitalE, vkCapitalF, vkCapitalG, vkCapitalH, vkCapitalI, vkCapitalJ, vkCapitalK, vkCapitalL, vkCapitalM,
    vkCapitalN, vkCapitalO, vkCapitalP, vkCapitalQ, vkCapitalR, vkCapitalS, vkCapitalT, vkCapitalU, vkCapitalV, vkCapitalW, vkCapitalX, vkCapitalY, vkCapitalZ,
    // unknow keys
    vkUnknown);

// keyboard interface functions
procedure RegisterKeyboard;
procedure DebugKeyboard;
function KeyIsDown(AKey : TKey) : boolean;
function KeyTrigger(AKey : TKey) : boolean;
 
implementation

type
  TKeyAndTime = class
    Key : TKey;
    Time : longint;
    Triger : longint;
    constructor Create(AKeyCode : integer; ASpecial : boolean); virtual;
  end;

var Keys : TList;
    StartDateTime : TDateTime;

function SpecialKeyCodeToKey(AKeyCode : integer) : TKey;
{*
Convert special key keycode to TKey enum
}
begin
  case AKeyCode of
    // Fn keys
    1:   result := vkF1;
    2:   result := vkF2;
    3:   result := vkF3;
    4:   result := vkF4;
    5:   result := vkF5;
    6:   result := vkF6;
    7:   result := vkF7;
    8:   result := vkF8;
    9:   result := vkF9;
    10:  result := vkF10;
    11:  result := vkF11;
    12:  result := vkF12;
    // arrows
    100: result := vkLeft;
    102: result := vkRight;
    101: result := vkUp;
    103: result := vkDown;
    // other
    104: result := vkPgUp;
    105: result := vkPgDn;
    106: result := vkHome;
    107: result := vkEnd;
    108: result := vkInsert;
  else
    result := vkUnknown;
  end;
end;

function NormalKeyCodeToKey(AKeyCode : integer) : TKey;
{*
Convert normal key keycode to TKey enum
}
begin
  if AKeyCode >= 65536 then
    AKeyCode := AKeyCode - 65536;
  case AKeyCode of
    // numbers
    48:  result := vkNumber0;
    49:  result := vkNumber1;
    50:  result := vkNumber2;
    51:  result := vkNumber3;
    52:  result := vkNumber4;
    53:  result := vkNumber5;
    54:  result := vkNumber6;
    55:  result := vkNumber7;
    56:  result := vkNumber8;
    57:  result := vkNumber9;
    // small letters
    97:  result := vkSmallA;
    98:  result := vkSmallB; 
    99:  result := vkSmallC; 
    100: result := vkSmallD; 
    101: result := vkSmallE; 
    102: result := vkSmallF; 
    103: result := vkSmallG; 
    104: result := vkSmallH; 
    105: result := vkSmallI; 
    106: result := vkSmallJ; 
    107: result := vkSmallK; 
    108: result := vkSmallL; 
    109: result := vkSmallM;
    110: result := vkSmallN;
    111: result := vkSmallO;
    112: result := vkSmallP;
    113: result := vkSmallQ;
    114: result := vkSmallR;
    115: result := vkSmallS;
    116: result := vkSmallT;
    117: result := vkSmallU;
    118: result := vkSmallV;
    119: result := vkSmallW; 
    120: result := vkSmallX;
    121: result := vkSmallY;
    122: result := vkSmallZ;
    // capital leters
    65: result := vkCapitalA;
    66: result := vkCapitalB;
    67: result := vkCapitalC;
    68: result := vkCapitalD;
    69: result := vkCapitalE;
    70: result := vkCapitalF;
    71: result := vkCapitalG;
    72: result := vkCapitalH;
    73: result := vkCapitalI;
    74: result := vkCapitalJ;
    75: result := vkCapitalK;
    76: result := vkCapitalL;
    77: result := vkCapitalM;
    78: result := vkCapitalN;
    79: result := vkCapitalO;
    80: result := vkCapitalP;
    81: result := vkCapitalQ;
    82: result := vkCapitalR;
    83: result := vkCapitalS;
    84: result := vkCapitalT;
    85: result := vkCapitalU;
    86: result := vkCapitalV;
    87: result := vkCapitalW;
    88: result := vkCapitalX;
    89: result := vkCapitalY;
    90: result := vkCapitalZ;
    // other
    127: result := vkDelete;
    32:  result := vkSpace;
    27:  result := vkEsc;
    13:  result := vkEnter;
    9:   result := vkTab;
    8:   result := vkBackSpace;
  else
    result := vkUnknown;
  end
end;

constructor TKeyAndTime.Create(AKeyCode : integer; ASpecial : boolean);
{*
Create key, assign Key from KeyCode and set Time
}
begin
  inherited Create;
  if ASpecial then
    Key := SpecialKeyCodeToKey(AKeyCode)
  else
    Key := NormalKeyCodeToKey(AKeyCode);
  Time := Round((Now-StartDateTime)*86400000);
end;

function KeyIsDown(AKey : TKey) : boolean;
{*
Return true if key K is pressed
}
var i : integer;
begin
  result := false;
  for i := 0 to Keys.Count-1 do
    if TKeyAndTime(Keys.Items[i]).Key = AKey then
      result := true;
end;

function KeyTrigger(AKey : TKey) : boolean;
{*
Return true only if key was pressed longer than ATimeout ms before
}
var i : integer;
begin
  result := false;
  for i := 0 to Keys.Count-1 do
    if TKeyAndTime(Keys.Items[i]).Key = AKey then
    begin
      // if never pressed before, use it now
      if TKeyAndTime(Keys.Items[i]).Triger = 0 then
      begin
        //writeln('first time triger');
        TKeyAndTime(Keys.Items[i]).Triger := Round((Now-StartDateTime)*86400000);
        result := true;
      end else
        //writeln('triger dt=',Round((Now-StartDateTime)*86400000) - TKeyAndTime(Keys.Items[i]).Triger);
        if Round((Now-StartDateTime)*86400000) - TKeyAndTime(Keys.Items[i]).Triger > 2500 then
        begin
          //writeln('TRIGER USED NOW');
          // update triger and use it
          TKeyAndTime(Keys.Items[i]).Triger := Round((Now-StartDateTime)*86400000);
          result := true;
        end;
      // exit - holded keys are multiple times but newer are first so we use time from first key only
      exit
    end; 
end;

procedure OnSpecialKey(AK, AX, AY: integer); cdecl;
{*
Mark key as pressed
}
begin
  Debug.Msg(dlInput, 'Special Key #' + IntToStr(AK) + ' PRESSED');
  Keys.Add(TKeyAndTime.Create(AK,true));
end;

procedure DeleteAndFreeKey(AKey : TKey);
{*
Find key in key list and remove and release it
}
var i : integer;
begin
  for i := Keys.Count-1 downto 0 do
  begin
    if TKeyAndTime(Keys.Items[i]).Key = AKey then
    begin
      TKeyAndTime(Keys.Items[i]).Free;
      Keys.Delete(i);
    end;
  end; 
end;

procedure OnSpecialKeyUp(AK, AX, AY: integer); cdecl;
{*
Mark special key as released
}
begin
  Debug.Msg(dlInput, 'Special Key #' + IntToStr(AK) + ' released');
  DeleteAndFreeKey(SpecialKeyCodeToKey(AK));
  if SpecialKeyCodeToKey(AK) = vkF11 then
    DebugKeyboard;
end;

procedure OnNormalKey(AK: Byte; AX, AY: integer); cdecl;
{*
Mark key as pressed
}
begin
  Debug.Msg(dlInput, 'Normal Key #' + IntToStr(AK) + ' PRESSED');
  Keys.Add(TKeyAndTime.Create(AK,false));
end;

procedure OnNormalKeyUp(AK: Byte; AX, AY: integer); cdecl;
{*
Mark key as released
}
begin
  Debug.Msg(dlInput, 'Special Key #' + IntToStr(AK) + ' released');
  DeleteAndFreeKey(NormalKeyCodeToKey(AK));
end;

procedure RegisterKeyboard;
{*
Register OpenGL callback functions
}
begin
  glutKeyboardFunc(OnNormalKey);
  glutKeyboardUpFunc(OnNormalKeyUp);
  glutSpecialFunc(OnSpecialKey);
  glutSpecialUpFunc(OnSpecialKeyUp);
end;        

procedure DebugKeyboard;
{*
Print pressed keys
}
var i : integer;
begin
  writeln('Keyboard (',Keys.Count,' pressed keys):');
  for i := 0 to Keys.Count-1 do
    with TKeyAndTime(Keys.Items[i]) do
    {$IFDEF FPC}
      writeln('  ',i,': Key=',Key,' Time=',Time);
    {$ELSE}
      writeln('  ',i,': Key=',ord(Key),' Time=',Time);
    {$ENDIF}
end;

initialization

  StartDateTime := Now;
  Keys := TList.Create;
  
finalization

  Debug.Msg(dlInfo,'Releasing Keys');
  Keys.Free;

end.
